
# R 数据分析可视化平台
# 基于 Shiny + tidyverse + ECharts4R

library(shiny)
library(shinydashboard)
library(tidyverse)
library(readxl)
library(DT)
library(echarts4r)
library(cluster)
library(factoextra)
library(corrplot)
library(rmarkdown)

# 设置中文支持
Sys.setlocale("LC_ALL", "Chinese")

# UI 界面
ui <- dashboardPage(
  dashboardHeader(title = "R数据分析平台"),
  
  dashboardSidebar(
    sidebarMenu(
      menuItem("数据上传", tabName = "upload", icon = icon("upload")),
      menuItem("数据概览", tabName = "overview", icon = icon("table")),
      menuItem("数据清洗", tabName = "clean", icon = icon("filter")),
      menuItem("统计分析", tabName = "analysis", icon = icon("chart-bar")),
      menuItem("机器学习", tabName = "ml", icon = icon("robot")),
      menuItem("可视化", tabName = "visual", icon = icon("chart-line")),
      menuItem("报告生成", tabName = "report", icon = icon("file-pdf"))
    )
  ),
  
  dashboardBody(
    tags$head(
      tags$link(rel = "stylesheet", type = "text/css", href = "www/custom.css"),
      tags$script(src = "www/custom.js")
    ),
    
    tabItems(
      # 数据上传
      tabItem(
        tabName = "upload",
        fluidRow(
          box(
            title = "文件上传",
            status = "primary",
            solidHeader = TRUE,
            width = 12,
            fileInput("file", "选择CSV或Excel文件",
                     accept = c(".csv", ".xlsx", ".xls")),
            checkboxInput("header", "包含表头", TRUE),
            radioButtons("sep", "分隔符:",
                        choices = c("逗号" = ",", "分号" = ";", "制表符" = "\t"),
                        selected = ",")
          )
        ),
        fluidRow(
          box(
            title = "数据预览",
            status = "info",
            solidHeader = TRUE,
            width = 12,
            DT::dataTableOutput("preview")
          )
        )
      ),
      
      # 数据概览
      tabItem(
        tabName = "overview",
        fluidRow(
          valueBoxOutput("n_rows"),
          valueBoxOutput("n_cols"),
          valueBoxOutput("missing_rate")
        ),
        fluidRow(
          box(
            title = "数据摘要",
            status = "primary",
            solidHeader = TRUE,
            width = 12,
            verbatimTextOutput("summary")
          )
        ),
        fluidRow(
          box(
            title = "数据类型",
            status = "info",
            solidHeader = TRUE,
            width = 12,
            tableOutput("data_types")
          )
        )
      ),
      
      # 数据清洗
      tabItem(
        tabName = "clean",
        fluidRow(
          box(
            title = "缺失值处理",
            status = "warning",
            solidHeader = TRUE,
            width = 6,
            checkboxGroupInput("na_cols", "选择要处理的列:",
                              choices = NULL),
            radioButtons("na_method", "处理方法:",
                        choices = c("删除" = "drop", 
                                   "均值填充" = "mean",
                                   "中位数填充" = "median",
                                   "众数填充" = "mode")),
            actionButton("handle_na", "处理缺失值", class = "btn-warning")
          ),
          box(
            title = "异常值处理",
            status = "danger",
            solidHeader = TRUE,
            width = 6,
            checkboxGroupInput("outlier_cols", "选择要处理的列:",
                              choices = NULL),
            numericInput("outlier_threshold", "异常值阈值 (IQR倍数):", 
                        value = 1.5, min = 1, max = 5, step = 0.1),
            actionButton("handle_outliers", "处理异常值", class = "btn-danger")
          )
        ),
        fluidRow(
          box(
            title = "清洗后数据预览",
            status = "success",
            solidHeader = TRUE,
            width = 12,
            DT::dataTableOutput("cleaned_data")
          )
        )
      ),
      
      # 统计分析
      tabItem(
        tabName = "analysis",
        fluidRow(
          box(
            title = "描述性统计",
            status = "primary",
            solidHeader = TRUE,
            width = 12,
            checkboxGroupInput("stat_cols", "选择数值列:",
                              choices = NULL),
            actionButton("descriptive_stats", "计算统计量", class = "btn-primary")
          )
        ),
        fluidRow(
          box(
            title = "相关性分析",
            status = "info",
            solidHeader = TRUE,
            width = 6,
            checkboxGroupInput("corr_cols", "选择变量:",
                              choices = NULL),
            actionButton("correlation", "计算相关系数", class = "btn-info")
          ),
          box(
            title = "t检验",
            status = "success",
            solidHeader = TRUE,
            width = 6,
            selectInput("t_group", "分组变量:", choices = NULL),
            selectInput("t_var", "检验变量:", choices = NULL),
            actionButton("t_test", "执行t检验", class = "btn-success")
          )
        ),
        fluidRow(
          box(
            title = "分析结果",
            status = "default",
            solidHeader = TRUE,
            width = 12,
            verbatimTextOutput("analysis_result")
          )
        )
      ),
      
      # 机器学习
      tabItem(
        tabName = "ml",
        fluidRow(
          box(
            title = "线性回归",
            status = "primary",
            solidHeader = TRUE,
            width = 6,
            selectInput("lm_y", "因变量:", choices = NULL),
            checkboxGroupInput("lm_x", "自变量:", choices = NULL),
            actionButton("run_lm", "运行回归", class = "btn-primary")
          ),
          box(
            title = "聚类分析",
            status = "info",
            solidHeader = TRUE,
            width = 6,
            checkboxGroupInput("cluster_vars", "聚类变量:", choices = NULL),
            numericInput("n_clusters", "聚类数:", value = 3, min = 2, max = 10),
            actionButton("run_cluster", "执行聚类", class = "btn-info")
          )
        ),
        fluidRow(
          box(
            title = "主成分分析",
            status = "success",
            solidHeader = TRUE,
            width = 12,
            checkboxGroupInput("pca_vars", "PCA变量:", choices = NULL),
            actionButton("run_pca", "执行PCA", class = "btn-success")
          )
        ),
        fluidRow(
          box(
            title = "模型结果",
            status = "default",
            solidHeader = TRUE,
            width = 12,
            verbatimTextOutput("ml_result")
          )
        )
      ),
      
      # 可视化
      tabItem(
        tabName = "visual",
        fluidRow(
          box(
            title = "图表类型",
            status = "primary",
            solidHeader = TRUE,
            width = 12,
            selectInput("plot_type", "选择图表类型:",
                       choices = c("散点图" = "scatter", 
                                  "柱状图" = "bar", 
                                  "箱线图" = "box",
                                  "直方图" = "hist",
                                  "折线图" = "line")),
            selectInput("x_var", "X轴变量:", choices = NULL),
            selectInput("y_var", "Y轴变量:", choices = NULL),
            selectInput("color_var", "颜色变量:", choices = c("无" = "none"), selected = "none"),
            actionButton("create_plot", "生成图表", class = "btn-primary")
          )
        ),
        fluidRow(
          box(
            title = "交互式图表",
            status = "info",
            solidHeader = TRUE,
            width = 12,
            echarts4rOutput("echart_plot", height = "500px")
          )
        )
      ),
      
      # 报告生成
      tabItem(
        tabName = "report",
        fluidRow(
          box(
            title = "报告配置",
            status = "primary",
            solidHeader = TRUE,
            width = 12,
            textInput("report_title", "报告标题:", value = "数据分析报告"),
            checkboxGroupInput("report_sections", "包含章节:",
                              choices = c("数据概览", "描述性统计", "相关性分析", 
                                        "回归分析", "聚类分析", "可视化"),
                              selected = c("数据概览", "描述性统计", "可视化")),
            actionButton("generate_report", "生成PDF报告", class = "btn-success")
          )
        ),
        fluidRow(
          box(
            title = "报告下载",
            status = "info",
            solidHeader = TRUE,
            width = 12,
            downloadButton("download_report", "下载报告", class = "btn-lg btn-primary")
          )
        )
      )
    )
  )
)

# 服务器逻辑
server <- function(input, output, session) {
  
  # 全局数据存储
  values <- reactiveValues(
    raw_data = NULL,
    cleaned_data = NULL,
    analysis_results = list()
  )
  
  # 数据上传与预览
  observeEvent(input$file, {
    req(input$file)
    
    tryCatch({
      # 读取数据
      if (grepl("\\.csv$", input$file$name)) {
        data <- read.csv(input$file$datapath, 
                        header = input$header, 
                        sep = input$sep,
                        stringsAsFactors = FALSE)
      } else {
        data <- read_excel(input$file$datapath)
      }
      
      values$raw_data <- data
      values$cleaned_data <- data
      
      # 更新选择框
      updateSelectInput(session, "x_var", choices = names(data))
      updateSelectInput(session, "y_var", choices = names(data))
      updateSelectInput(session, "color_var", choices = c("无" = "none", names(data)))
      
      # 更新清洗模块
      updateCheckboxGroupInput(session, "na_cols", choices = names(data))
      updateCheckboxGroupInput(session, "outlier_cols", choices = names(data))
      
      # 更新分析模块
      numeric_cols <- names(data)[sapply(data, is.numeric)]
      updateCheckboxGroupInput(session, "stat_cols", choices = numeric_cols)
      updateCheckboxGroupInput(session, "corr_cols", choices = numeric_cols)
      updateCheckboxGroupInput(session, "lm_x", choices = numeric_cols)
      updateSelectInput(session, "lm_y", choices = numeric_cols)
      updateCheckboxGroupInput(session, "cluster_vars", choices = numeric_cols)
      updateCheckboxGroupInput(session, "pca_vars", choices = numeric_cols)
      
      # 更新t检验模块
      factor_cols <- names(data)[sapply(data, is.factor) | sapply(data, is.character)]
      updateSelectInput(session, "t_group", choices = factor_cols)
      updateSelectInput(session, "t_var", choices = numeric_cols)
      
    }, error = function(e) {
      showNotification(paste("文件读取错误:", e$message), type = "error")
    })
  })
  
  # 数据预览
  output$preview <- DT::renderDataTable({
    req(values$raw_data)
    datatable(values$raw_data, options = list(pageLength = 10))
  })
  
  # 数据概览
  output$n_rows <- renderValueBox({
    req(values$raw_data)
    valueBox(
      nrow(values$raw_data),
      "数据行数",
      icon = icon("table"),
      color = "blue"
    )
  })
  
  output$n_cols <- renderValueBox({
    req(values$raw_data)
    valueBox(
      ncol(values$raw_data),
      "数据列数",
      icon = icon("columns"),
      color = "green"
    )
  })
  
  output$missing_rate <- renderValueBox({
    req(values$raw_data)
    missing_rate <- sum(is.na(values$raw_data)) / (nrow(values$raw_data) * ncol(values$raw_data)) * 100
    valueBox(
      paste0(round(missing_rate, 2), "%"),
      "缺失值比例",
      icon = icon("exclamation-triangle"),
      color = "yellow"
    )
  })
  
  output$summary <- renderPrint({
    req(values$raw_data)
    summary(values$raw_data)
  })
  
  output$data_types <- renderTable({
    req(values$raw_data)
    data.frame(
      列名 = names(values$raw_data),
      类型 = sapply(values$raw_data, class),
      行数 = sapply(values$raw_data, length)
    )
  })
  
  # 数据清洗
  observeEvent(input$handle_na, {
    req(values$cleaned_data, input$na_cols)
    
    data <- values$cleaned_data
    
    if (input$na_method == "drop") {
      data <- data[complete.cases(data[input$na_cols]), ]
    } else if (input$na_method == "mean") {
      for (col in input$na_cols) {
        if (is.numeric(data[[col]])) {
          data[[col]][is.na(data[[col]])] <- mean(data[[col]], na.rm = TRUE)
        }
      }
    } else if (input$na_method == "median") {
      for (col in input$na_cols) {
        if (is.numeric(data[[col]])) {
          data[[col]][is.na(data[[col]])] <- median(data[[col]], na.rm = TRUE)
        }
      }
    }
    
    values$cleaned_data <- data
    showNotification("缺失值处理完成", type = "success")
  })
  
  observeEvent(input$handle_outliers, {
    req(values$cleaned_data, input$outlier_cols)
    
    data <- values$cleaned_data
    
    for (col in input$outlier_cols) {
      if (is.numeric(data[[col]])) {
        q1 <- quantile(data[[col]], 0.25, na.rm = TRUE)
        q3 <- quantile(data[[col]], 0.75, na.rm = TRUE)
        iqr <- q3 - q1
        lower <- q1 - input$outlier_threshold * iqr
        upper <- q3 + input$outlier_threshold * iqr
        
        data[[col]][data[[col]] < lower | data[[col]] > upper] <- NA
      }
    }
    
    values$cleaned_data <- data
    showNotification("异常值处理完成", type = "success")
  })
  
  output$cleaned_data <- DT::renderDataTable({
    req(values$cleaned_data)
    datatable(values$cleaned_data, options = list(pageLength = 10))
  })
  
  # 统计分析
  observeEvent(input$descriptive_stats, {
    req(values$cleaned_data, input$stat_cols)
    
    stats <- values$cleaned_data[input$stat_cols] %>%
      summarise_all(list(
        均值 = ~mean(., na.rm = TRUE),
        标准差 = ~sd(., na.rm = TRUE),
        最小值 = ~min(., na.rm = TRUE),
        最大值 = ~max(., na.rm = TRUE),
        中位数 = ~median(., na.rm = TRUE)
      ))
    
    values$analysis_results$descriptive <- stats
    output$analysis_result <- renderPrint({ stats })
  })
  
  observeEvent(input$correlation, {
    req(values$cleaned_data, input$corr_cols)
    
    corr <- cor(values$cleaned_data[input$corr_cols], use = "complete.obs")
    values$analysis_results$correlation <- corr
    
    output$analysis_result <- renderPrint({ corr })
  })
  
  observeEvent(input$t_test, {
    req(values$cleaned_data, input$t_group, input$t_var)
    
    formula <- as.formula(paste(input$t_var, "~", input$t_group))
    t_result <- t.test(formula, data = values$cleaned_data)
    
    values$analysis_results$t_test <- t_result
    output$analysis_result <- renderPrint({ t_result })
  })
  
  # 机器学习
  observeEvent(input$run_lm, {
    req(values$cleaned_data, input$lm_y, input$lm_x)
    
    formula <- as.formula(paste(input$lm_y, "~", paste(input$lm_x, collapse = " + ")))
    model <- lm(formula, data = values$cleaned_data)
    
    values$analysis_results$lm <- model
    output$ml_result <- renderPrint({ summary(model) })
  })
  
  observeEvent(input$run_cluster, {
    req(values$cleaned_data, input$cluster_vars)
    
    data_scaled <- scale(values$cleaned_data[input$cluster_vars])
    kmeans_result <- kmeans(data_scaled, centers = input$n_clusters)
    
    values$analysis_results$cluster <- kmeans_result
    output$ml_result <- renderPrint({ kmeans_result })
  })
  
  observeEvent(input$run_pca, {
    req(values$cleaned_data, input$pca_vars)
    
    pca_result <- prcomp(values$cleaned_data[input$pca_vars], scale = TRUE)
    
    values$analysis_results$pca <- pca_result
    output$ml_result <- renderPrint({ summary(pca_result) })
  })
  
  # 可视化
  observeEvent(input$create_plot, {
    req(values$cleaned_data, input$x_var, input$y_var)
    
    data <- values$cleaned_data
    
    if (input$color_var != "none") {
      plot_data <- data[c(input$x_var, input$y_var, input$color_var)]
    } else {
      plot_data <- data[c(input$x_var, input$y_var)]
    }
    
    p <- plot_data %>%
      e_charts(x = !!sym(input$x_var)) %>%
      {
        if (input$plot_type == "scatter") {
          e_scatter(!!sym(input$y_var))
        } else if (input$plot_type == "bar") {
          e_bar(!!sym(input$y_var))
        } else if (input$plot_type == "box") {
          e_boxplot(!!sym(input$y_var))
        } else if (input$plot_type == "hist") {
          e_histogram(!!sym(input$y_var))
        } else if (input$plot_type == "line") {
          e_line(!!sym(input$y_var))
        }
      }
    
    if (input$color_var != "none") {
      p <- p %>% e_color(input$color_var)
    }
    
    output$echart_plot <- renderEcharts4r({ p })
  })
  
  # 报告生成
  observeEvent(input$generate_report, {
    req(values$cleaned_data)
    
    temp_report <- tempfile(fileext = ".Rmd")
    file.copy("modules/report_template.Rmd", temp_report, overwrite = TRUE)
    
    params <- list(
      title = input$report_title,
      data = values$cleaned_data,
      results = values$analysis_results,
      sections = input$report_sections
    )
    
    tryCatch({
      rmarkdown::render(temp_report, 
                       params = params,
                       output_file = "analysis_report.pdf",
                       output_dir = "reports")
      
      showNotification("报告生成完成", type = "success")
    }, error = function(e) {
      showNotification(paste("报告生成失败:", e$message), type = "error")
    })
  })
  
  output$download_report <- downloadHandler(
    filename = function() {
      paste0("数据分析报告_", Sys.Date(), ".pdf")
    },
    content = function(file) {
      if (file.exists("reports/analysis_report.pdf")) {
        file.copy("reports/analysis_report.pdf", file)
      } else {
        showNotification("请先生成报告", type = "warning")
      }
    }
  )
}

# 运行应用
shinyApp(ui = ui, server = server)
